home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-9.10-netbook-remix-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / Debconf / ConfModule.pm < prev    next >
Text File  |  2009-10-02  |  16KB  |  670 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::ConfModule;
  6. use strict;
  7. use IPC::Open2;
  8. use FileHandle;
  9. use Debconf::Gettext;
  10. use Debconf::Config;
  11. use Debconf::Question;
  12. use Debconf::Priority qw(priority_valid high_enough);
  13. use Debconf::FrontEnd::Noninteractive;
  14. use Debconf::Log ':all';
  15. use Debconf::Encoding;
  16. use base qw(Debconf::Base);
  17.  
  18.  
  19. my %codes = (
  20.     success => 0,
  21.     escaped_data => 1,
  22.     badparams => 10,
  23.     syntaxerror => 20,
  24.     input_invisible => 30,
  25.     version_bad => 30,
  26.     go_back => 30,
  27.     progresscancel => 30,
  28.     internalerror => 100,
  29. );
  30.  
  31.  
  32. sub init {
  33.     my $this=shift;
  34.  
  35.     $this->version("2.0");
  36.     
  37.     $this->owner('unknown') if ! defined $this->owner;
  38.     
  39.     $this->frontend->capb_backup('');
  40.  
  41.     $this->seen([]);
  42.     $this->busy([]);
  43.  
  44.     $ENV{DEBIAN_HAS_FRONTEND}=1;
  45. }
  46.  
  47.  
  48. sub startup {
  49.     my $this=shift;
  50.     my $confmodule=shift;
  51.  
  52.     $this->frontend->clear;
  53.     $this->busy([]);
  54.     
  55.     my @args=$this->confmodule($confmodule);
  56.     push @args, @_ if @_;
  57.     
  58.     debug developer => "starting ".join(' ',@args);
  59.     $this->pid(open2($this->read_handle(FileHandle->new),
  60.                  $this->write_handle(FileHandle->new),
  61.              @args)) || die $!;
  62.         
  63.     $this->caught_sigpipe('');
  64.     $SIG{PIPE}=sub { $this->caught_sigpipe(128) };
  65. }
  66.  
  67.  
  68. sub communicate {
  69.     my $this=shift;
  70.  
  71.     my $r=$this->read_handle;
  72.     $_=<$r> || return $this->finish;
  73.     chomp;
  74.     my $ret=$this->process_command($_);
  75.     my $w=$this->write_handle;
  76.     print $w $ret."\n";
  77.     return '' unless length $ret;
  78.     return 1;
  79. }
  80.  
  81.  
  82. sub escape {
  83.     my $text=shift;
  84.     $text=~s/\\/\\\\/g;
  85.     $text=~s/\n/\\n/g;
  86.     return $text;
  87. }
  88.  
  89.  
  90. sub unescape_split {
  91.     my $text=shift;
  92.     my @words;
  93.     my $word='';
  94.     for my $chunk (split /(\\.|\s+)/, $text) {
  95.         if ($chunk eq '\n') {
  96.             $word.="\n";
  97.         } elsif ($chunk=~/^\\(.)$/) {
  98.             $word.=$1;
  99.         } elsif ($chunk=~/^\s+$/) {
  100.             push @words, $word;
  101.             $word='';
  102.         } else {
  103.             $word.=$chunk;
  104.         }
  105.     }
  106.     push @words, $word if $word ne '';
  107.     return @words;
  108. }
  109.  
  110.  
  111. sub process_command {
  112.     my $this=shift;
  113.     
  114.     debug developer => "<-- $_";
  115.     return 1 unless defined && ! /^\s*#/; # Skip blank lines, comments.
  116.     chomp;
  117.     my ($command, @params);
  118.     if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) {
  119.         ($command, @params)=unescape_split($_);
  120.     } else {
  121.         ($command, @params)=split(' ', $_);
  122.     }
  123.     $command=lc($command);
  124.     if (lc($command) eq "stop") {
  125.         return $this->finish;
  126.     }
  127.     if (! $this->can("command_$command")) {
  128.         return $codes{syntaxerror}.' '.
  129.                "Unsupported command \"$command\" (full line was \"$_\") received from confmodule.";
  130.     }
  131.     $command="command_$command";
  132.     my $ret=join(' ', $this->$command(@params));
  133.     debug developer => "--> $ret";
  134.     if ($ret=~/\n/) {
  135.         debug developer => 'Warning: return value is multiline, and would break the debconf protocol. Truncating to first line.';
  136.         $ret=~s/\n.*//s;
  137.         debug developer => "--> $ret";
  138.     }
  139.     return $ret;
  140. }
  141.  
  142.  
  143. sub finish {
  144.     my $this=shift;
  145.  
  146.     waitpid $this->pid, 0 if defined $this->pid;
  147.     $this->exitcode($this->caught_sigpipe || ($? >> 8));
  148.  
  149.     $SIG{PIPE} = sub {};
  150.     
  151.     foreach (@{$this->seen}) {
  152.         my $q=Debconf::Question->get($_->name);
  153.         $_->flag('seen', 'true') if $q;
  154.     }
  155.     $this->seen([]);
  156.     
  157.     return '';
  158. }
  159.  
  160.  
  161. sub command_input {
  162.     my $this=shift;
  163.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2;
  164.     my $priority=shift;
  165.     my $question_name=shift;
  166.     
  167.     my $question=Debconf::Question->get($question_name) ||
  168.         return $codes{badparams}, "\"$question_name\" doesn't exist";
  169.  
  170.     if (! priority_valid($priority)) {
  171.         return $codes{syntaxerror}, "\"$priority\" is not a valid priority";
  172.     }
  173.  
  174.     $question->priority($priority);
  175.     
  176.     my $visible=1;
  177.  
  178.     if ($question->type ne 'error') {
  179.         $visible='' unless high_enough($priority);
  180.  
  181.         $visible='' if ! Debconf::Config->reshow &&
  182.                    $question->flag('seen') eq 'true';
  183.     }
  184.  
  185.     my $markseen=$visible;
  186.  
  187.     if ($visible && ! $this->frontend->interactive) {
  188.         $visible='';
  189.         $markseen='' unless Debconf::Config->noninteractive_seen eq 'true';
  190.     }
  191.  
  192.     my $element;
  193.     if ($visible) {
  194.         $element=$this->frontend->makeelement($question);
  195.         unless ($element) {
  196.             return $codes{internalerror},
  197.                    "unable to make an input element";
  198.         }
  199.  
  200.         $visible=$element->visible;
  201.     }
  202.  
  203.     if (! $visible) {
  204.         $element=Debconf::FrontEnd::Noninteractive->makeelement($question, 1);
  205.  
  206.         return $codes{input_invisible}, "question skipped" unless $element;
  207.     }
  208.  
  209.     $element->markseen($markseen);
  210.  
  211.     push @{$this->busy}, $question_name;
  212.     
  213.     $this->frontend->add($element);
  214.     if ($element->visible) {
  215.         return $codes{success}, "question will be asked";
  216.     }
  217.     else {
  218.         return $codes{input_invisible}, "question skipped";
  219.     }
  220. }
  221.  
  222.  
  223. sub command_clear {
  224.     my $this=shift;
  225.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 0;
  226.  
  227.     $this->frontend->clear;
  228.     $this->busy([]);
  229.     return $codes{success};
  230. }
  231.  
  232.  
  233. sub command_version {
  234.     my $this=shift;
  235.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 1;
  236.     my $version=shift;
  237.     if (defined $version) {
  238.         return $codes{version_bad}, "Version too low ($version)"
  239.             if int($version) < int($this->version);
  240.         return $codes{version_bad}, "Version too high ($version)"
  241.             if int($version) > int($this->version);
  242.     }
  243.     return $codes{success}, $this->version;
  244. }
  245.  
  246.  
  247. sub command_capb {
  248.     my $this=shift;
  249.     $this->client_capb([@_]);
  250.     $this->frontend->capb_backup(1) if grep { $_ eq 'backup' } @_;
  251.     my @capb=('multiselect', 'escape');
  252.     push @capb, $this->frontend->capb;
  253.     return $codes{success}, @capb;
  254. }
  255.  
  256.  
  257. sub command_title {
  258.     my $this=shift;
  259.     $this->frontend->title(join ' ', @_);
  260.     $this->frontend->requested_title($this->frontend->title);
  261.  
  262.     return $codes{success};
  263. }
  264.  
  265.  
  266. sub command_settitle {
  267.     my $this=shift;
  268.     
  269.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  270.     my $question_name=shift;
  271.     
  272.     my $question=Debconf::Question->get($question_name) ||
  273.         return $codes{badparams}, "\"$question_name\" doesn't exist";
  274.  
  275.     if ($this->frontend->can('settitle')) {
  276.         $this->frontend->settitle($question);
  277.     } else {
  278.         $this->frontend->title($question->description);
  279.     }
  280.     $this->frontend->requested_title($this->frontend->title);
  281.     
  282.     return $codes{success};
  283. }
  284.  
  285.  
  286. sub command_beginblock {
  287.     return $codes{success};
  288. }
  289. sub command_endblock {
  290.     return $codes{success};
  291. }
  292.  
  293.  
  294. sub command_go {
  295.     my $this=shift;
  296.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 0;
  297.  
  298.     my $ret=$this->frontend->go;
  299.     if ($ret && (! $this->backed_up ||
  300.                  grep { $_->visible } @{$this->frontend->elements})) {
  301.         foreach (@{$this->frontend->elements}) {
  302.             $_->question->value($_->value);
  303.             push @{$this->seen}, $_->question if $_->markseen && $_->question;
  304.         }
  305.         $this->frontend->clear;
  306.         $this->busy([]);
  307.         $this->backed_up('');
  308.         return $codes{success}, "ok"
  309.     }
  310.     else {
  311.         $this->frontend->clear;
  312.         $this->busy([]);
  313.         $this->backed_up(1);
  314.         return $codes{go_back}, "backup";
  315.     }
  316. }
  317.  
  318.  
  319. sub command_get {
  320.     my $this=shift;
  321.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  322.     my $question_name=shift;
  323.     my $question=Debconf::Question->get($question_name) ||
  324.         return $codes{badparams}, "$question_name doesn't exist";
  325.  
  326.     my $value=$question->value;
  327.     if (defined $value) {
  328.         if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) {
  329.             return $codes{escaped_data}, escape($value);
  330.         } else {
  331.             return $codes{success}, $value;
  332.         }
  333.     }
  334.     else {
  335.         return $codes{success}, '';
  336.     }
  337. }
  338.  
  339.  
  340. sub command_set {
  341.     my $this=shift;
  342.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1;
  343.     my $question_name=shift;
  344.     my $value=join(" ", @_);
  345.  
  346.     my $question=Debconf::Question->get($question_name) ||
  347.         return $codes{badparams}, "$question_name doesn't exist";
  348.     $question->value($value);
  349.     return $codes{success}, "value set";
  350. }
  351.  
  352.  
  353. sub command_reset {
  354.     my $this=shift;
  355.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  356.     my $question_name=shift;
  357.  
  358.     my $question=Debconf::Question->get($question_name) ||
  359.         return $codes{badparams}, "$question_name doesn't exist";
  360.     $question->value($question->default);
  361.     $question->flag('seen', 'false');
  362.     return $codes{success};
  363. }
  364.  
  365.  
  366. sub command_subst {
  367.     my $this = shift;
  368.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 2;
  369.     my $question_name = shift;
  370.     my $variable = shift;
  371.     my $value = (join ' ', @_);
  372.     
  373.     my $question=Debconf::Question->get($question_name) ||
  374.         return $codes{badparams}, "$question_name doesn't exist";
  375.     my $result=$question->variable($variable,$value);
  376.     return $codes{internalerror}, "Substitution failed" unless defined $result;
  377.     return $codes{success};
  378. }
  379.  
  380.  
  381. sub command_register {
  382.     my $this=shift;
  383.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2;
  384.     my $template=shift;
  385.     my $name=shift;
  386.     
  387.     my $tempobj = Debconf::Question->get($template);
  388.     if (! $tempobj) {
  389.         return $codes{badparams}, "No such template, \"$template\"";
  390.     }
  391.     my $question=Debconf::Question->get($name) || 
  392.                  Debconf::Question->new($name, $this->owner, $tempobj->type);
  393.     if (! $question) {
  394.         return $codes{internalerror}, "Internal error making question";
  395.     }
  396.     if (! defined $question->addowner($this->owner, $tempobj->type)) {
  397.         return $codes{internalerror}, "Internal error adding owner";
  398.     }
  399.     if (! $question->template($template)) {
  400.         return $codes{internalerror}, "Internal error setting template";
  401.     }
  402.  
  403.     return $codes{success};
  404. }
  405.  
  406.  
  407. sub command_unregister {
  408.     my $this=shift;
  409.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  410.     my $name=shift;
  411.     
  412.     my $question=Debconf::Question->get($name) ||
  413.         return $codes{badparams}, "$name doesn't exist";
  414.     if (grep { $_ eq $name } @{$this->busy}) {
  415.         return $codes{badparams}, "$name is busy, cannot unregister right now";
  416.     }
  417.     $question->removeowner($this->owner);
  418.     return $codes{success};
  419. }
  420.  
  421.  
  422. sub command_purge {
  423.     my $this=shift;
  424.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 0;
  425.     
  426.     my $iterator=Debconf::Question->iterator;
  427.     while (my $q=$iterator->iterate) {
  428.         $q->removeowner($this->owner);
  429.     }
  430.  
  431.     return $codes{success};
  432. }
  433.  
  434.  
  435. sub command_metaget {
  436.     my $this=shift;
  437.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2;
  438.     my $question_name=shift;
  439.     my $field=shift;
  440.     
  441.     my $question=Debconf::Question->get($question_name) ||
  442.         return $codes{badparams}, "$question_name doesn't exist";
  443.     my $lcfield=lc $field;
  444.     my $fieldval=$question->$lcfield();
  445.     unless (defined $fieldval) {
  446.         return $codes{badparams}, "$field does not exist";
  447.     }
  448.     if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) {
  449.         return $codes{escaped_data}, escape($fieldval);
  450.     } else {
  451.         return $codes{success}, $fieldval;
  452.     }
  453. }
  454.  
  455.  
  456. sub command_fget {
  457.     my $this=shift;
  458.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2;
  459.     my $question_name=shift;
  460.     my $flag=shift;
  461.     
  462.     my $question=Debconf::Question->get($question_name) ||
  463.         return $codes{badparams},  "$question_name doesn't exist";
  464.         
  465.     return $codes{success}, $question->flag($flag);
  466. }
  467.  
  468.  
  469. sub command_fset {
  470.     my $this=shift;
  471.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 3;
  472.     my $question_name=shift;
  473.     my $flag=shift;
  474.     my $value=(join ' ', @_);
  475.     
  476.     my $question=Debconf::Question->get($question_name) ||
  477.         return $codes{badparams}, "$question_name doesn't exist";
  478.  
  479.     if ($flag eq 'seen') {
  480.         $this->seen([grep {$_ ne $question} @{$this->seen}]);
  481.     }
  482.         
  483.     return $codes{success}, $question->flag($flag, $value);
  484. }
  485.  
  486.  
  487. sub command_info {
  488.     my $this=shift;
  489.  
  490.     if (@_ == 0) {
  491.         $this->frontend->info(undef);
  492.     } elsif (@_ == 1) {
  493.         my $question_name=shift;
  494.  
  495.         my $question=Debconf::Question->get($question_name) ||
  496.             return $codes{badparams}, "\"$question_name\" doesn't exist";
  497.  
  498.         $this->frontend->info($question);
  499.     } else {
  500.         return $codes{syntaxerror}, "Incorrect number of arguments";
  501.     }
  502.  
  503.     return $codes{success};
  504. }
  505.  
  506.  
  507. sub command_progress {
  508.     my $this=shift;
  509.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1;
  510.     my $subcommand=shift;
  511.     $subcommand=lc($subcommand);
  512.     
  513.     my $ret;
  514.  
  515.     if ($subcommand eq 'start') {
  516.         return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 3;
  517.         my $min=shift;
  518.         my $max=shift;
  519.         my $question_name=shift;
  520.  
  521.         return $codes{syntaxerror}, "min ($min) > max ($max)" if $min > $max;
  522.  
  523.         my $question=Debconf::Question->get($question_name) ||
  524.             return $codes{badparams}, "$question_name doesn't exist";
  525.  
  526.         $this->frontend->progress_start($min, $max, $question);
  527.         $ret=1;
  528.     }
  529.     elsif ($subcommand eq 'set') {
  530.         return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  531.         my $value=shift;
  532.         $ret = $this->frontend->progress_set($value);
  533.     }
  534.     elsif ($subcommand eq 'step') {
  535.         return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  536.         my $inc=shift;
  537.         $ret = $this->frontend->progress_step($inc);
  538.     }
  539.     elsif ($subcommand eq 'info') {
  540.         return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  541.         my $question_name=shift;
  542.  
  543.         my $question=Debconf::Question->get($question_name) ||
  544.             return $codes{badparams}, "$question_name doesn't exist";
  545.  
  546.         $ret = $this->frontend->progress_info($question);
  547.     }
  548.     elsif ($subcommand eq 'stop') {
  549.         return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 0;
  550.         $this->frontend->progress_stop();
  551.         $ret=1;
  552.     }
  553.     else {
  554.         return $codes{syntaxerror}, "Unknown subcommand";
  555.     }
  556.  
  557.     if ($ret) {
  558.         return $codes{success}, "OK";
  559.     }
  560.     else {
  561.         return $codes{progresscancel}, "CANCELED";
  562.     }
  563. }
  564.  
  565.  
  566. sub command_data {
  567.     my $this=shift;
  568.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 3;
  569.     my $template=shift;
  570.     my $item=shift;
  571.     my $value=join(' ', @_);
  572.     $value=~s/\\([n"\\])/($1 eq 'n') ? "\n" : $1/eg;
  573.  
  574.     my $tempobj=Debconf::Template->get($template);
  575.     if (! $tempobj) {
  576.         if ($item ne 'type') {
  577.             return $codes{badparams}, "Template data field '$item' received before type field";
  578.         }
  579.         $tempobj=Debconf::Template->new($template, $this->owner, $value);
  580.         if (! $tempobj) {
  581.             return $codes{internalerror}, "Internal error making template";
  582.         }
  583.     } else {
  584.         if ($item eq 'type') {
  585.             return $codes{badparams}, "Template type already set";
  586.         }
  587.         $tempobj->$item(Debconf::Encoding::convert("UTF-8", $value));
  588.     }
  589.  
  590.     return $codes{success};
  591. }
  592.  
  593.  
  594. sub command_visible {
  595.     my $this=shift;
  596.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2;
  597.     my $priority=shift;
  598.     my $question_name=shift;
  599.     
  600.     my $question=Debconf::Question->get($question_name) ||
  601.         return $codes{badparams}, "$question_name doesn't exist";
  602.     return $codes{success}, $this->frontend->visible($question, $priority) ? "true" : "false";
  603. }
  604.  
  605.  
  606. sub command_exist {
  607.     my $this=shift;
  608.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1;
  609.     my $question_name=shift;
  610.     
  611.     return $codes{success}, 
  612.         Debconf::Question->get($question_name) ? "true" : "false";
  613. }
  614.  
  615.  
  616. sub command_x_loadtemplatefile {
  617.     my $this=shift;
  618.  
  619.     return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1 || @_ > 2;
  620.  
  621.     my $file=shift;
  622.     my $fh=FileHandle->new($file);
  623.     if (! $fh) {
  624.         return $codes{badparams}, "failed to open $file: $!";
  625.     }
  626.  
  627.     my $owner=$this->owner;
  628.     if (@_) {
  629.         $owner=shift;
  630.     }
  631.  
  632.     eval {
  633.         Debconf::Template->load($fh, $owner);
  634.     };
  635.     if ($@) {
  636.         $@=~s/\n/\\n/g;
  637.         return $codes{internalerror}, $@;
  638.     }
  639.     return $codes{success};
  640. }
  641.  
  642.  
  643. sub AUTOLOAD {
  644.     (my $field = our $AUTOLOAD) =~ s/.*://;
  645.  
  646.     no strict 'refs';
  647.     *$AUTOLOAD = sub {
  648.         my $this=shift;
  649.         
  650.         return $this->{$field} unless @_;
  651.         return $this->{$field}=shift;
  652.     };
  653.     goto &$AUTOLOAD;
  654. }
  655.  
  656.  
  657. sub DESTROY {
  658.     my $this=shift;
  659.     
  660.     $this->read_handle->close if $this->read_handle;
  661.     $this->write_handle->close if $this->write_handle;
  662.     
  663.     if (defined $this->pid && $this->pid > 1) {
  664.         kill 'TERM', $this->pid;
  665.     }
  666. }
  667.  
  668.  
  669. 1
  670.